(in-package :game)

(defparameter *suits* '(spades clubs diamonds hearts))
(defparameter *card-values* '(7 8 9 10 jack queen king ace))
(defparameter *full-deck* (loop for suit in *suits* nconc
                            (loop for card-value in *card-values*
                               collect (cons card-value suit))))

(defun tossed-deck ()
  (mapcar #'first
    (sort (mapcar #'(lambda (x) (list x (random 10000))) *full-deck*)
      #'<
      :key #'second)))

(defparameter *game* nil)

(defun id-auto-increment (class-name)
  (let ((max-id-obj     
          (first (find-persistent-objects *game-store* class-name 
                   :order-by (cons 'id :desc)
                   :range  '(0 1)))))
  (if max-id-obj
    (+ 1 (object-id max-id-obj))
    1)))

(defun cards-compare-for-sort (card-1 card-2)
  "sort order in hand"
  (member card-1 (member card-2 *full-deck* :test #'equal) :test #'equal))

(defun cards-compare-for-game (card-1 card-2 trump)
  "compare cards for trick T if card-2 wins
   if cards have same suit then wins card, than has bigger value
   if suits are different trump wins,
   if there's no trump wins first card"
  (if (equal (cdr card-1) (cdr card-2))
    (member (car card-2) (member (car card-1) *card-values* :test #'equal) :test #'equal)
    (equal trump (cdr card-2))))

(defclass game-state ()
  ((id :initform (id-auto-increment 'game-state) :initarg :id)
  (west :initform nil)
  (player :initform nil)
  (east :initform nil)
  (prikup :initform nil)
  (opponent-cards-is-hidden :initform nil)
  (stage :initform 'auction)))

(defmethod initialize-instance :after ((state game-state) &rest args)
(declare (ignorable args))
  (let ((deck (tossed-deck)))
    (dotimes (i 5 nil)
      (loop for hand in '(west east player) do
        (dotimes (j 2 nil)
          (push  (pop deck) (slot-value state hand))))))
  (loop for hand in '(west east player) do
    (setf  (slot-value state hand) 
           (sort (slot-value state hand) #'cards-compare-for-sort))))
;; for now create new game
;; TODO load persistent
;;
(defun game-load ()
  (if *game*
     *game*
     (if (setf *game* (first (find-persistent-objects *game-store* 'game-state)))
      *game*
      (setf *game* (make-instance 'game-state)))))

(defun random-pick-inner (v lst)
  (if (<= (setf v (- v (second (first lst)))) 0)
    (first (first lst))
    (random-pick-inner v (cdr lst))))

(defun random-pick (weighted-list)
   (random-pick-inner (random (loop for x in weighted-list sum (second x))) weighted-list))

(defun guessed-random-position (known possible-cards-with-weight count)
  (if (<= count (length known))
    known
    (progn
      (push (random-pick possible-cards-with-weight) known)
      (setf possible-cards-with-weight (remove (first known) possible-cards-with-weight :test #'equal :key #'first)) 
      (format t "picked: ~a last: ~a~%" (first known) (length possible-cards-with-weight))
      (guessed-random-position known possible-cards-with-weight count))))

(defun filter-suit (cards suit)
  (remove-if-not #'(lambda (x) (equal suit (cdr x))) cards))

(defun possible-moves (first-move cards &key (trump nil))
(or (filter-suit cards (cdr first-move))
     (filter-suit cards (if first-move trump nil))
     cards))

(defclass player ()
  ((cards :initform nil :initarg :cards)
   (tricks :initform nil :initarg :tricks)
   (goal :initform 2 :initarg :goal)
   (west-cooperation :initform 'no-coop)
   (east-cooperation :initform 'no-coop)))

(defmacro remove-all-but-suit (cards suit)
  "Return only cards of given suit"
  (let ((s (gensym)))
  `(let ((,s ,suit))
     (remove-if-not #'(lambda (x) (equal (cdr x) ,s)) ,cards))))

(defun possible-moves (first-card cards trump)
  "Return cards that can play if first card in trick is known"
   (or (remove-all-but-suit cards (cdr first-card))
      (remove-all-but-suit cards trump)
      cards))

(defun select-winning-cards (test-card pretenders trump &optional reverse)
  "select cards from pretenerers that win over test-card"
  ;; this function is here instead of lamba only for debugging purpose 
  (defun filter-winning-card (card)
    (cards-compare-for-game test-card card trump))
  (funcall (if reverse 'remove-if 'remove-if-not) #'filter-winning-card preteners))

(defun highest-opponent-card (cards-on-table left-side-player-cards trump)
  (let ((first-card (first cards-on-table))
        (second-card (second cards-on-table)))
    (if second-card
      (if (cards-compare-for-game first-card second-card trump)
        second-card
        first-card)
      (let ((left-player-pretenders 
              (select-winning-cards 
                 first-card 
                 (possible-moves first-card left-side-player-cards trump) 
                 trump)))
         (if left-player-pretenders
            (first (sort left-player-pretenders #'cards-compare-for-sort))
            first-card)))))

(defun lowest-opponents-card (cards-on-table left-side-player-cards trump)
  (let ((first-card (first cards-on-table))
        (second-card (second cards-on-table)))
   (if second-card 
      (if (cards-compare-for-game first-card second-card trump)
        first-card
        second-card)
      ;; TODO
      first-card)))

(defun winning-cards (cards-on-table player left right trump)
  "return unconditionally winning cards of player, if any"
  (defun loser-card (card)
    (or
          (select-winning-cards card (possible-moves card left trump) trump)
          (select-winning-cards card (possible-moves card right trump) trump)))

  (if cards-on-table
    (select-winning-cards 
      (highest-opponent-card cards-on-table left trump)
      (possible-moves (first cards-on-table) player trump)
      trump)
    ;; "elegant" but not optimal
    (remove-if #'loser-card player)))

(defun losing-cards (cards-on-table player left right trump)
  "return unconditionally losing cards of player (for misere etc.)"
  (defun list-is-unbeatable (card list)
    (if list
      (and (cards-compare-for-game card (car list) trump)
           (list-is-unbeatable card (cdr list)))
      t))
  (defun card-can-not-win (card)
    (when (and (list-is-unbeatable card (possible-moves card right trump))
               (list-is-unbeatable card (possible-moves card left trump)))
      (list card)))

  (defun list-has-lower-cards (card list)
    (if list
      (or (not (cards-compare-for-game card (car list) trump)) 
          (list-has-lower-cards card (cdr list)))
      nil))


  (defun hi-card ()
    (let ((card-1 (first cards-on-table))
          (card-2 (second cards-on-table)))
      (if card-2
          (if (cards-compare-for-game card-1 card-2 trump)
            card-2
            card-1)
          (let* ((p-cards (possible-moves card-1 left trump))) 
            (if (list-has-lower-cards card-1 p-cards trump)
              card-1
              (last (sort #'cards-compare-for-sort p-cards)))))))

  (if cards-on-table
    (let ((hc (hi-card)))
      (mapcan 
         #'(lambda (x) 
            (unless (cards-compare-for-game hc x trump) 
              (list x)))
         (possible-moves (first cards-on-table) player trump)))
    (mapcan #'card-can-not-win player)))


